home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / advanc2a / vbmemcap.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-03-18  |  8.6 KB  |  255 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "COMCTL32.OCX"
  3. Begin VB.Form frmMain 
  4.    BackColor       =   &H8000000C&
  5.    Caption         =   "VB Memcap"
  6.    ClientHeight    =   3645
  7.    ClientLeft      =   165
  8.    ClientTop       =   735
  9.    ClientWidth     =   4725
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   243
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   315
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin ComctlLib.StatusBar StatusBar 
  16.       Align           =   2  'Align Bottom
  17.       Height          =   255
  18.       Left            =   0
  19.       TabIndex        =   0
  20.       Top             =   3390
  21.       Width           =   4725
  22.       _ExtentX        =   8334
  23.       _ExtentY        =   450
  24.       Style           =   1
  25.       SimpleText      =   ""
  26.       _Version        =   327680
  27.       BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
  28.          NumPanels       =   1
  29.          BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
  30.             TextSave        =   ""
  31.             Key             =   ""
  32.             Object.Tag             =   ""
  33.          EndProperty
  34.       EndProperty
  35.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  36.          Name            =   "Arial"
  37.          Size            =   8.25
  38.          Charset         =   0
  39.          Weight          =   400
  40.          Underline       =   0   'False
  41.          Italic          =   0   'False
  42.          Strikethrough   =   0   'False
  43.       EndProperty
  44.       MouseIcon       =   "VBmemcap.frx":0000
  45.    End
  46.    Begin VB.Menu mnuFile 
  47.       Caption         =   "&File"
  48.       Begin VB.Menu mnuAllocate 
  49.          Caption         =   "&Allocate"
  50.       End
  51.       Begin VB.Menu mnuExit 
  52.          Caption         =   "E&xit"
  53.       End
  54.    End
  55.    Begin VB.Menu mnuEdit 
  56.       Caption         =   "&Edit"
  57.       Begin VB.Menu mnuCopy 
  58.          Caption         =   "&Copy"
  59.          Shortcut        =   ^C
  60.       End
  61.    End
  62.    Begin VB.Menu mnuControl 
  63.       Caption         =   "&Control"
  64.       Begin VB.Menu mnuStart 
  65.          Caption         =   "&Start"
  66.       End
  67.       Begin VB.Menu mnuDisplay 
  68.          Caption         =   "&Display"
  69.       End
  70.       Begin VB.Menu mnuFormat 
  71.          Caption         =   "&Format"
  72.          Shortcut        =   ^F
  73.       End
  74.       Begin VB.Menu mnuSource 
  75.          Caption         =   "S&ource"
  76.       End
  77.       Begin VB.Menu mnuCompression 
  78.          Caption         =   "Co&mpression"
  79.       End
  80.       Begin VB.Menu mnuLine1 
  81.          Caption         =   "-"
  82.       End
  83.       Begin VB.Menu mnuSelect 
  84.          Caption         =   "&Select"
  85.          Shortcut        =   ^S
  86.       End
  87.       Begin VB.Menu mnuScale 
  88.          Caption         =   "Sc&ale"
  89.          Checked         =   -1  'True
  90.          Shortcut        =   ^A
  91.       End
  92.       Begin VB.Menu mnuPreview 
  93.          Caption         =   "&Preview"
  94.          Checked         =   -1  'True
  95.          Shortcut        =   ^P
  96.       End
  97.       Begin VB.Menu mnuLine2 
  98.          Caption         =   "-"
  99.       End
  100.       Begin VB.Menu mnuAlwaysVisible 
  101.          Caption         =   "Al&ways Visible"
  102.          Shortcut        =   ^W
  103.       End
  104.    End
  105. Attribute VB_Name = "frmMain"
  106. Attribute VB_GlobalNameSpace = False
  107. Attribute VB_Creatable = False
  108. Attribute VB_PredeclaredId = True
  109. Attribute VB_Exposed = False
  110. '* Author: E. J. Bantz Jr.
  111. '* Copyright: None, use and distribute freely ...
  112. '* E-Mail: ej@bantz.com
  113. '* Web: http://ej.bantz.com
  114. Option Explicit
  115. Private Sub Form_Load()
  116.     Dim lpszName As String * 100
  117.     Dim lpszVer As String * 100
  118.     Dim Caps As CAPDRIVERCAPS
  119.         
  120.     '//Create Capture Window
  121.     capGetDriverDescriptionA 0, lpszName, 100, lpszVer, 100  '// Retrieves driver info
  122.     lwndC = capCreateCaptureWindowA(lpszName, WS_CAPTION Or WS_THICKFRAME Or WS_VISIBLE Or WS_CHILD, 0, 0, 160, 120, Me.hWnd, 0)
  123.     '// Set title of window to name of driver
  124.     SetWindowText lwndC, lpszName
  125.     '// Set the video stream callback function
  126.     capSetCallbackOnStatus lwndC, AddressOf MyStatusCallback
  127.     capSetCallbackOnError lwndC, AddressOf MyErrorCallback
  128.     '// Connect the capture window to the driver
  129.     If capDriverConnect(lwndC, 0) Then
  130.         '/////
  131.         '// Only do the following if the connect was successful.
  132.         '// if it fails, the error will be reported in the call
  133.         '// back function.
  134.         '/////
  135.         '// Get the capabilities of the capture driver
  136.         capDriverGetCaps lwndC, VarPtr(Caps), Len(Caps)
  137.         
  138.         '// If the capture driver does not support a dialog, grey it out
  139.         '// in the menu bar.
  140.         If Caps.fHasDlgVideoSource = 0 Then mnuSource.Enabled = False
  141.         If Caps.fHasDlgVideoFormat = 0 Then mnuFormat.Enabled = False
  142.         If Caps.fHasDlgVideoDisplay = 0 Then mnuDisplay.Enabled = False
  143.         
  144.         '// Turn Scale on
  145.         capPreviewScale lwndC, True
  146.             
  147.         '// Set the preview rate in milliseconds
  148.         capPreviewRate lwndC, 66
  149.         
  150.         '// Start previewing the image from the camera
  151.         capPreview lwndC, True
  152.             
  153.         '// Resize the capture window to show the whole image
  154.         ResizeCaptureWindow lwndC
  155.     End If
  156. End Sub
  157. Private Sub Form_Unload(Cancel As Integer)
  158.     '// Disable all callbacks
  159.     capSetCallbackOnError lwndC, vbNull
  160.     capSetCallbackOnStatus lwndC, vbNull
  161.     capSetCallbackOnYield lwndC, vbNull
  162.     capSetCallbackOnFrame lwndC, vbNull
  163.     capSetCallbackOnVideoStream lwndC, vbNull
  164.     capSetCallbackOnWaveStream lwndC, vbNull
  165.     capSetCallbackOnCapControl lwndC, vbNull
  166. End Sub
  167. Private Sub mnuAllocate_Click()
  168.  Dim sFile As String * 250
  169.  Dim lSize As Long
  170.  '// Setup swap file for capture
  171.  lSize = 1000000
  172.  sFile = "C:\TEMP.AVI"
  173.  capFileSetCaptureFile lwndC, sFile
  174.  capFileAlloc lwndC, lSize
  175. End Sub
  176. Private Sub mnuAlwaysVisible_Click()
  177.     mnuAlwaysVisible.Checked = Not (mnuAlwaysVisible.Checked)
  178.     If mnuAlwaysVisible.Checked Then
  179.         SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
  180.     Else
  181.         SetWindowPos Me.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
  182.     End If
  183. End Sub
  184. Private Sub mnuCompression_Click()
  185. '   /*
  186. '   * Display the Compression dialog when "Compression" is selected from
  187. '   * the menu bar.
  188. '   */
  189.     capDlgVideoCompression lwndC
  190. End Sub
  191. Private Sub mnuCopy_Click()
  192.     capEditCopy lwndC
  193.         
  194. End Sub
  195. Private Sub mnuDisplay_Click()
  196. '   /*
  197. '   * Display the Video Display dialog when "Display" is selected from
  198. '   * the menu bar.
  199. '   */
  200.     capDlgVideoDisplay lwndC
  201. End Sub
  202. Private Sub mnuExit_Click()
  203.     Unload Me
  204. End Sub
  205. Private Sub mnuFormat_Click()
  206. '  /*
  207. '   * Display the Video Format dialog when "Format" is selected from the
  208. '   * menu bar.
  209. '   */
  210.     capDlgVideoFormat lwndC
  211.     ResizeCaptureWindow lwndC
  212. End Sub
  213. Private Sub mnuPreview_Click()
  214.     frmMain.StatusBar.SimpleText = vbNullString
  215.     mnuPreview.Checked = Not (mnuPreview.Checked)
  216.     capPreview lwndC, mnuPreview.Checked
  217. End Sub
  218. Private Sub mnuScale_Click()
  219.     mnuScale.Checked = Not (mnuScale.Checked)
  220.     capPreviewScale lwndC, mnuScale.Checked
  221.     If mnuScale.Checked Then
  222.        SetWindowLong lwndC, GWL_STYLE, WS_THICKFRAME Or WS_CAPTION Or WS_VISIBLE Or WS_CHILD
  223.     Else
  224.        SetWindowLong lwndC, GWL_STYLE, WS_BORDER Or WS_CAPTION Or WS_VISIBLE Or WS_CHILD
  225.     End If
  226.     ResizeCaptureWindow lwndC
  227. End Sub
  228. Private Sub mnuSelect_Click()
  229.     frmSelect.Show vbModal, Me
  230. End Sub
  231. Private Sub mnuSource_Click()
  232. '   /*
  233. '    * Display the Video Source dialog when "Source" is selected from the
  234. '    * menu bar.
  235. '    */
  236.     capDlgVideoSource lwndC
  237. End Sub
  238. Private Sub mnuStart_Click()
  239. '  * If Start is selected from the menu, start Streaming capture.
  240. '  * The streaming capture is terminated when the Escape key is pressed
  241. '  */
  242.     Dim sFileName As String
  243.     Dim CAP_PARAMS As CAPTUREPARMS
  244.     capCaptureGetSetup lwndC, VarPtr(CAP_PARAMS), Len(CAP_PARAMS)
  245.     CAP_PARAMS.dwRequestMicroSecPerFrame = (1 * (10 ^ 6)) / 30  ' 30 Frames per second
  246.     CAP_PARAMS.fMakeUserHitOKToCapture = True
  247.     CAP_PARAMS.fCaptureAudio = False
  248.     capCaptureSetSetup lwndC, VarPtr(CAP_PARAMS), Len(CAP_PARAMS)
  249.     sFileName = "C:\myvideo.avi"
  250.     capCaptureSequence lwndC  ' Start Capturing!
  251.     capFileSaveAs lwndC, sFileName  ' Copy video from swap file into a real file.
  252. End Sub
  253. Private Sub StatusBar1_PanelClick(ByVal Panel As ComctlLib.Panel)
  254. End Sub
  255.